home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Moscow ML 1.42 / src / compiler / Filename.mlp < prev    next >
Encoding:
Text File  |  1997-08-18  |  3.7 KB  |  166 lines  |  [TEXT/R*ch]
  1. (* filename.mlp *)
  2.  
  3. open CharVector;
  4.  
  5. fun check_suffix name suff =
  6.   let val name_len = size name
  7.       val suff_len = size suff
  8.   in
  9.     name_len >= suff_len andalso
  10.     extract(name, name_len - suff_len, SOME suff_len) = suff
  11.   end;
  12.  
  13. fun chop_suffix name suff =
  14.   extract(name, 0, SOME (size name - size suff))
  15. ;
  16.  
  17. #ifdef unix
  18. val current_dir_name = ".";
  19.  
  20. fun concat dirname filename =
  21.   let val len = size dirname
  22.       val x   = if len = 0 then "/" else extract(dirname, len-1, SOME 1)
  23.   in
  24.     case x of
  25.         "/"   => dirname ^ filename
  26.       | _     => dirname ^ "/" ^ filename
  27.   end;
  28.  
  29. fun is_absolute n =
  30.   let val len = size n in
  31.      (len >= 1 andalso extract(n, 0, SOME 1) = "/")    orelse
  32.      (len >= 2 andalso extract(n, 0, SOME 2) = "./")   orelse
  33.      (len >= 3 andalso extract(n, 0, SOME 3) = "../")
  34.   end;
  35.  
  36. fun slash_pos s =
  37.   let fun pos i =
  38.     if i < 0 then NONE else
  39.     case extract(s, i, SOME 1) of
  40.         "/"  => SOME i
  41.       | _    => pos (i - 1)
  42.   in pos (size s - 1) end
  43. ;
  44.  
  45. fun basename name =
  46.   case slash_pos name of
  47.       SOME p => 
  48.         extract(name, p+1, NONE)
  49.     | NONE   => name
  50. ;
  51.  
  52. fun dirname name =
  53.   if name = "/" then name else
  54.   case slash_pos name of
  55.       SOME p  => extract(name, 0, SOME p)
  56.     | NONE    => "."
  57. ;
  58. #endif
  59.  
  60. #ifdef macintosh
  61. val current_dir_name = ":";
  62.  
  63. fun is_absolute n =
  64.   let val len = size n
  65.       fun h i = 
  66.         if i >= len then false
  67.         else if extract(n, i, SOME 1) = ":" then true
  68.         else h (i+1)
  69.   in h 0 end;
  70.  
  71. fun concat dirname filename =
  72.   let val dirname1 =
  73.         if is_absolute dirname
  74.         then dirname
  75.         else ":" ^ dirname
  76.       val l = size dirname1 - 1
  77.       val dirname2 =
  78.         if l < 0 orelse extract(dirname1, l, SOME 1) = ":"
  79.         then dirname1
  80.         else dirname1 ^ ":"
  81.       val len = size filename
  82.       val filename2 =
  83.         if len > 0 andalso extract(filename, 0, SOME 1) = ":"
  84.         then extract(filename, 1, NONE)
  85.         else filename 
  86.   in dirname2 ^ filename2 end
  87. ;
  88.  
  89. fun colon_pos s =
  90.   let fun pos i =
  91.     if i < 0 then NONE else
  92.     case extract(s, i, SOME 1) of
  93.         ":"  => SOME i
  94.       | _    => pos (i - 1)
  95.   in pos (size s - 1) end
  96. ;
  97.  
  98. fun basename name =
  99.   case colon_pos name of
  100.       SOME p => 
  101.         extract(name, p+1, NONE)
  102.     | NONE   => name
  103. ;
  104.  
  105. fun dirname name =
  106.   if name = ":" then name else
  107.   case colon_pos name of
  108.       SOME p  => extract(name, 0, SOME p)
  109.     | NONE    => ":"
  110. ;
  111. #endif
  112.  
  113. #ifdef msdos
  114. val current_dir_name = ".";
  115.  
  116. fun concat dirname filename =
  117.   let val len = size dirname
  118.       val x   = if len = 0 then "\\" else extract(dirname, len-1, SOME 1)
  119.   in
  120.     case x of
  121.         "\\"  => dirname ^ filename
  122.       | ":"   => dirname ^ filename
  123.       | _     => dirname ^ "\\" ^ filename
  124.   end;
  125.  
  126. fun is_absolute n =
  127.   let val len = size n in
  128.     (len >= 2 andalso extract(n, 1, SOME 1) = ":")     orelse 
  129.     (len >= 1 andalso extract(n, 0, SOME 1) = "\\")    orelse 
  130.     (len >= 2 andalso extract(n, 0, SOME 2) = ".\\")   orelse 
  131.     (len >= 3 andalso extract(n, 0, SOME 3) = "..\\")
  132.   end;
  133.  
  134. fun sep_pos s =
  135.   let fun pos i =
  136.     if i < 0 then NONE else
  137.     case extract(s, i, SOME 1) of
  138.         "/"  => SOME i
  139.       | "\\" => SOME i
  140.       | ":"  => SOME i
  141.       | _    => pos (i - 1)
  142.   in pos (size s - 1) end
  143. ;
  144.  
  145. fun basename name =
  146.   case sep_pos name of
  147.       SOME p => 
  148.         extract(name, p+1, NONE)
  149.     | NONE   => name
  150. ;
  151.  
  152. fun dirname name =
  153.   let val len = size name in
  154.     if len >= 2 andalso extract(name, 1, SOME 1) = ":" then
  155.       extract(name, 0, SOME 2) ^ 
  156.         dirname (extract(name, 2, NONE))
  157.     else if name = "/" orelse name = "\\" then
  158.       name
  159.     else
  160.       case sep_pos name of
  161.           SOME p => extract(name, 0, SOME p)
  162.         | NONE   => "."
  163.   end;
  164.  
  165. #endif
  166.